CD Ware Multimedia 1995 May

home *** CD-ROM | disk | FTP | other *** search

/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / WIN / VB_TOOLS / VBCOUNT.ZIP / FRMMAIN.FRM (.txt) < prev next >

Wrap

Visual Basic Form | 1994-04-01 | 25.8 KB | 767 lines

VERSION 2.00 Begin Form frmMain BorderStyle = 1 'Fixed Single Caption = "VB Code Counter" ClientHeight = 4845 ClientLeft = 1110 ClientTop = 1545 ClientWidth = 6615 Height = 5280 Icon = FRMMAIN.FRX:0000 Left = 1035 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 323 ScaleMode = 3 'Pixel ScaleWidth = 441 Top = 1185 Width = 6765 Begin OptionButton optMode Caption = "Approx. Module Size" Height = 240 Index = 1 Left = 2790 TabIndex = 13 Top = 2205 Width = 2040 End Begin OptionButton optMode Caption = "Lines of Code" Height = 240 Index = 0 Left = 2790 TabIndex = 21 Top = 1935 Value = -1 'True Width = 1500 End Begin PictureBox picProgress FillColor = &H00000080& FillStyle = 0 'Solid ForeColor = &H00000080& Height = 1380 Left = 1080 ScaleHeight = 1350 ScaleWidth = 210 TabIndex = 25 TabStop = 0 'False Top = 2955 Visible = 0 'False Width = 240 End Begin CommandButton cmdCredit Caption = " &Credit" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Serif" FontSize = 6 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 240 Left = 5490 TabIndex = 8 Top = 1260 Width = 555 End Begin PictureBox picFrame Height = 1770 Left = 1575 ScaleHeight = 116 ScaleMode = 3 'Pixel ScaleWidth = 314 TabIndex = 22 TabStop = 0 'False Top = 2745 Width = 4740 Begin VScrollBar vsbResults Height = 1740 Left = 4455 TabIndex = 9 Top = 0 Visible = 0 'False Width = 270 End Begin PictureBox picResults AutoRedraw = -1 'True BorderStyle = 0 'None FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 1365 Left = 0 ScaleHeight = 91 ScaleMode = 3 'Pixel ScaleWidth = 740 TabIndex = 23 TabStop = 0 'False Top = 0 Width = 11100 End End Begin CommandButton cmdExit Caption = "E&xit" Height = 330 Left = 5310 TabIndex = 7 Top = 765 Width = 915 End Begin CommandButton cmdOK Caption = "&OK" Default = -1 'True Height = 330 Left = 5310 TabIndex = 6 Top = 360 Width = 915 End Begin FileListBox lstMak Height = 810 Left = 1590 Pattern = "*.mak" TabIndex = 1 Top = 345 Width = 1260 End Begin DirListBox lstDir Height = 1380 Left = 3075 TabIndex = 3 Top = 345 Width = 1890 End Begin DriveListBox lstDrive Height = 315 Left = 1590 TabIndex = 5 Top = 1410 Width = 1260 End Begin Label lblCurFile BackStyle = 0 'Transparent FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000080& Height = 240 Left = 180 TabIndex = 29 Top = 2235 Width = 2400 End Begin Label lblProgress BackStyle = 0 'Transparent ForeColor = &H00000080& Height = 420 Left = 510 TabIndex = 26 Top = 3420 Visible = 0 'False Width = 465 End Begin Label lblProgBar Alignment = 1 'Right Justify BackColor = &H00000000& BackStyle = 0 'Transparent Caption = "0" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 195 Index = 1 Left = 630 TabIndex = 28 Top = 4170 Visible = 0 'False Width = 420 End Begin Label lblProgBar Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "100" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000000& Height = 195 Index = 0 Left = 630 TabIndex = 27 Top = 2925 Visible = 0 'False Width = 420 End Begin Label Label1 BackColor = &H00FFFFFF& BackStyle = 0 'Transparent Caption = "(bytes)" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000000& Height = 195 Index = 11 Left = 4860 TabIndex = 24 Top = 2235 Width = 645 End Begin Label lblTotEvent Alignment = 1 'Right Justify BackColor = &H00FFFFFF& BackStyle = 0 'Transparent Caption = "0" ForeColor = &H00800000& Height = 195 Left = 3900 TabIndex = 19 Top = 4545 Width = 1005 WordWrap = -1 'True End Begin Label lblTotal Alignment = 1 'Right Justify BackColor = &H00FFFFFF& BackStyle = 0 'Transparent Caption = "0" ForeColor = &H00800000& Height = 195 Left = 4950 TabIndex = 20 Top = 4545 Width = 1005 WordWrap = -1 'True End Begin Label lblTotProp Alignment = 1 'Right Justify BackColor = &H00FFFFFF& BackStyle = 0 'Transparent Caption = "0" ForeColor = &H00800000& Height = 195 Left = 2805 TabIndex = 18 Top = 4545 Width = 1050 WordWrap = -1 'True End Begin Label lblTotUnits BackColor = &H00FFFFFF& BackStyle = 0 'Transparent Caption = "TOTAL Lines" Height = 195 Left = 1590 TabIndex = 17 Top = 4545 Width = 1500 WordWrap = -1 'True End Begin Label Label1 BackColor = &H00FFFFFF& BackStyle = 0 'Transparent Caption = "(w/o blanks or comments)" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000000& Height = 195 Index = 8 Left = 4320 TabIndex = 15 Top = 1965 Width = 1950 WordWrap = -1 'True End Begin Label Label1 Alignment = 1 'Right Justify BackColor = &H00FFFFFF& BackStyle = 0 'Transparent Caption = "Total" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 195 Index = 7 Left = 4980 TabIndex = 14 Top = 2520 Width = 960 End Begin Label Label1 BackColor = &H00FFFFFF& BackStyle = 0 'Transparent Caption = "&Directory" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 195 Index = 6 Left = 3105 TabIndex = 2 Top = 135 Width = 1005 End Begin Label Label1 BackColor = &H00FFFFFF& BackStyle = 0 'Transparent Caption = "&File" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 195 Index = 5 Left = 1590 TabIndex = 0 Top = 135 Width = 1005 End Begin Label Label1 Alignment = 1 'Right Justify BackColor = &H00FFFFFF& BackStyle = 0 'Transparent Caption = "Procedures" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 195 Index = 2 Left = 3885 TabIndex = 12 Top = 2520 Width = 1005 End Begin Label Label1 Alignment = 1 'Right Justify BackColor = &H00FFFFFF& BackStyle = 0 'Transparent Caption = "Forms/Controls" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 195 Index = 1 Left = 2430 TabIndex = 11 Top = 2520 Width = 1410 WordWrap = -1 'True End Begin Label Label1 BackColor = &H00FFFFFF& BackStyle = 0 'Transparent Caption = "Module" Height = 195 Index = 0 Left = 1590 TabIndex = 10 Top = 2520 Width = 1005 End Begin Label Label1 Alignment = 1 'Right Justify BackColor = &H00FFFFFF& BackStyle = 0 'Transparent Caption = "Select a VB project .MAK file, then click the OK button." ForeColor = &H00800000& Height = 1095 Index = 9 Left = 45 TabIndex = 16 Top = 360 Width = 1410 WordWrap = -1 'True End Begin Label Label1 BackColor = &H00FFFFFF& BackStyle = 0 'Transparent Caption = "Dri&ve" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 195 Index = 4 Left = 1590 TabIndex = 4 Top = 1200 Width = 1005 End 'VB CODE COUNTER '------------------------ 'This mini-app counts the code lines and characters 'in each of a VB project's modules, then displays either 'the total lines of code or the approximate byte size 'for each module and for the project as a whole. 'Comments in the code should make apparent just how it 'works. The interesting part mostly is in cmdOK_Click and 'the procedures it calls. 'See the README.TXT file for more info. '(Note: the program expects that all project files 'have been saved in ASCII format.) 'Allan Colby '4/1/94 'CIS 71257,760 '--------------------------------- Option Explicit Option Compare Text 'housekeeping variables Dim msProjFile$() 'full path to files read from list in .MAK Dim mnNumFiles% 'number of files in project Dim msCurFileTitle$ 'name only for file currently being read Dim mbShowBytes% 'mode selected by user - bytes or lines of code Dim mbFormatOK% 'flag to denote if current file passed check for ASCII format 'data variables Dim mlPropLines& 'current count of form/control property definition lines Dim mlEventLines& 'as above for event procedure lines Dim mlPropBytes& 'current count of form/control property definition characters Dim mlEventBytes& 'as above for event procedure bytes Dim mlTotPropLines& '\ Dim mlTotEventLines& ' [Running totals for the four items above] Dim mlTotPropBytes& ' Dim mlTotEventBytes& '/ Sub cmdCredit_Click () MsgBox "Created 3/84 by" & Chr$(13) & Chr$(10) & "Allan Colby" & Chr$(13) & Chr$(10) & "CIS 71257,760", 64 End Sub Sub cmdExit_Click () End End Sub Sub cmdOK_Click () Dim n%, f$ Static RunningFlag 'prevents re-click during a DoEvents '(numerous DoEvents calls are included 'to ensure action occurs and screen repaints) If RunningFlag Then Exit Sub On Error GoTo NoFileErr 'Check that valid MAK file is selected f = lstMAK.Path & "\" & lstMAK.FileName If Not FileExists(f) Then MsgBox "Cannot find that .MAK file.", 48, Me.Caption Exit Sub End If 'If so, reset form and proceed. screen.MousePointer = 11 RunningFlag = True picResults.Cls picResults.Height = picFrame.ScaleHeight - 1 picResults.Top = 0 mlTotPropLines = 0 mlTotEventLines = 0 mlTotPropBytes = 0 mlTotEventBytes = 0 mnNumFiles = 0 lblTotProp = "0" lblTotEvent = "0" lblTotal = "0" DoEvents 'get project info ReadMAK 'set up and show progress bar if there's more than 1 file If mnNumFiles > 1 Then picProgress.Cls picProgress.Visible = True lblProgBar(0).Visible = True lblProgBar(1).Visible = True lblProgress = "0%" lblProgress.Visible = True DoEvents End If 'get data from each file For n = 0 To mnNumFiles - 1 SetProgressBar n DoEvents 'extract FileName from FileSpec and set variable f = msProjFile(n) Do Until InStr(f, "\") = False f = Right(f, Len(f) - InStr(f, "\")) Loop msCurFileTitle = f 'display what we're currently working on lblCurFile = "Reading: " & msCurFileTitle DoEvents ReadFile msProjFile(n) DoEvents Next 'hide progress bar & status label picProgress.Visible = False lblProgBar(0).Visible = False lblProgBar(1).Visible = False lblProgress.Visible = False 'set status label If mnNumFiles = 1 Then f = " file read." Else f = " files read." lblCurFile = UCase(lstMAK.FileName) & ": " & mnNumFiles & f screen.MousePointer = 0 RunningFlag = False 'signal completion Beep Exit Sub NoFileErr: MsgBox "No file selected, or could not locate selected file.", 48 RunningFlag = False screen.MousePointer = 0 Exit Sub Resume End Sub Function FileExists (FileName As String) As Integer Dim Test$ On Error Resume Next 'If Dir returns anything but an error or empty 'string, file must exist. Test$ = Dir$(FileName) If Test$ = "" Or Err <> 0 Then FileExists = False Else FileExists = True End If End Function Sub Form_Load () 'Center form Me.Move (screen.Width - Me.Width) / 2, .9 * (screen.Height - Me.Height) / 2 mbShowBytes = optMode(1) 'init value End Sub Sub lstDir_Change () lstMAK.Path = lstDir.Path End Sub Sub lstDrive_Change () lstDir.Path = lstDrive.Drive End Sub Sub lstMak_DblClick () cmdOK_Click End Sub Sub optMode_Click (Index As Integer) 'set mode flag mbShowBytes = optMode(1) 'position display pic box so approp. info is visible If mbShowBytes Then picResults.Left = -440 Else picResults.Left = 0 'reset Total values SetTotals End Sub Sub ReadFile (FileSpec$) 'Read each file to count valid lines and characters Dim f%, n%, t$ 'temp variables & counters Dim LineRead$ 'current line read Dim CountingProperties% 'flag for whether we're in form/control properties section Dim ReadingString% 'flag for whether we're inside a string 'init variables mlPropLines = 0 mlEventLines = 0 mlPropBytes = 0 mlEventBytes = 0 mbFormatOK = False CountingProperties = False ReadingString = False 'open file f = FreeFile Open FileSpec For Input As #f Do Until EOF(f) 'get each line Line Input #f, LineRead 'remove any leading spaces or tabs Do Until Left(LineRead, 1) <> " " And Left(LineRead, 1) <> Chr$(9) LineRead = Right(LineRead, Len(LineRead) - 1) Loop '[This next bit is done only on the first pass.] '------------------------------------------------------------------ 'check for ASCII format; apparently, if 1st line starts with Chr(255) 'or Chr(252), file was saved in binary and not ASCII format. If Not mbFormatOK Then If Left(LineRead, 1) = Chr(255) Or Left(LineRead, 1) = Chr(252) Then 'skip to print routine Close #f ShowResults Exit Sub Else 'set flag so we skip this on subsequent passes for this file mbFormatOK = True End If End If '------------------------------------------------------------------ 'make sure line isn't blank or a comment If LineRead <> "" And Left(LineRead, 1) <> "'" Then 'otherwise flag if it's starting a form or control properties definition, 'which starts with "Begin ". [Note: Must include space after "Begin" to 'avoid finding "BeginTrans" in an event procedure.] If Left(LineRead, 6) = "Begin " Then CountingProperties = True 'add to the properties or procedures count as approp. If CountingProperties Then mlPropLines = mlPropLines + 1 Else mlEventLines = mlEventLines + 1 'clear flag if ending properties section '(Note: Any "End ..." statement in event procedure section has no impact 'as flag already will have been cleared.) If LineRead = "End" Then CountingProperties = False 'count characters in LineRead, except for line-end comments n = 0 'init counter Do 'increment counter n = n + 1 'get next character t = Mid(LineRead, n, 1) 'keep track of whether we're inside a string (t = ") If t = Chr$(34) Then ReadingString = Not ReadingString 'If there's an apostrophe that's not inside a string, it 'must be the start of a line-end comment, so bail out If Not ReadingString And t = Chr$(39) Then Exit Do 'if we get this far, it's a countable character, 'so increment TotBytes If CountingProperties Then mlPropBytes = mlPropBytes + 1 Else mlEventBytes = mlEventBytes + 1 Loop Until n = Len(LineRead) 'at end of line, add 2 bytes for CR+LF, which Input Line trims If CountingProperties Then mlPropBytes = mlPropBytes + 2 Else mlEventBytes = mlEventBytes + 2 End If Loop Close #f 'set total values mlTotPropLines = mlTotPropLines + mlPropLines mlTotEventLines = mlTotEventLines + mlEventLines mlTotPropBytes = mlTotPropBytes + mlPropBytes mlTotEventBytes = mlTotEventBytes + mlEventBytes 'Display results for this file ShowResults End Sub Sub ReadMAK () Dim f% 'file number Dim MAKFile$ 'full path to .MAK file Dim LineRead$ 'current line from .MAK file Dim temp$ 'temp string f = FreeFile mnNumFiles = 0 'open MAK file MAKFile = lstMAK.Path & "\" & lstMAK.FileName Open MAKFile For Input As #f Do Until EOF(f) 'get each line Line Input #f, LineRead 'if LineRead contains no backslash, it might be a 'filename in same dir with MAK, so append MAK path 'to front. If Not InStr(LineRead, "\") Then temp = lstMAK.Path & "\" & LineRead Else temp = LineRead 'now see if line (as modified) is a valid file name If FileExists(temp) Then 'if so, check that it's not a .VBX If Right(temp, 4) <> ".VBX" Then 'if not a .VBX, store its full path and 'increment NumFiles counter ReDim Preserve msProjFile(mnNumFiles + 1) msProjFile(mnNumFiles) = temp mnNumFiles = mnNumFiles + 1 End If End If Loop Close #f End Sub Sub SetProgressBar (CurIndex As Integer) Dim p!, h%, w% 'determine current file index as proportion of total p = (CurIndex + 1) / mnNumFiles If p = 1 Then p = .99 'don't show 100% 'draw colored box in pic box relative to p w = picProgress.ScaleWidth h = picProgress.ScaleHeight picProgress.Line (0, h)-(w, (h - p * h)), , BF 'update progress label lblProgress = Format(p, "0%") & " done" End Sub Sub SetTotals () 'place total values in approp. labels If Not mbShowBytes Then 'showing lines of code lblTotProp = mlTotPropLines lblTotEvent = mlTotEventLines lblTotal = mlTotPropLines + mlTotEventLines lblTotUnits = "TOTAL Lines" Else 'showing bytes lblTotProp = mlTotPropBytes lblTotEvent = mlTotEventBytes lblTotal = mlTotPropBytes + mlTotEventBytes lblTotUnits = "TOTAL Bytes" End If End Sub Sub ShowResults () 'Add Results to pic box display Dim t$ 'temp string 'enlarge pic box and show scroll bar if nec. If picResults.Height < (picResults.TextHeight("A") * mnNumFiles) Then picResults.Height = (picResults.TextHeight("A") * mnNumFiles) If picResults.Height > picFrame.ScaleHeight Then vsbResults.Max = picResults.Height - picFrame.ScaleHeight vsbResults.LargeChange = picFrame.ScaleHeight vsbResults.SmallChange = picResults.TextHeight("A") vsbResults.Visible = True DoEvents End If 'Move the display pic box up if we've gotten to the bottom of the viewport If picResults.CurrentY > picFrame.ScaleHeight Then vsbResults.Value = vsbResults.Value + vsbResults.SmallChange 'Print file name to pic box twice for different columns '(we'll move the pic box to left or right depending on which info ' the user wants to see.) picResults.Print msCurFileTitle; picResults.CurrentX = 440 picResults.Print msCurFileTitle; '----------------------------------------------------------- 'If check for ASCII format failed, just append message (again in 'two columns) and bail out If Not mbFormatOK Then t = "[file not saved as text]" picResults.CurrentX = 140 picResults.Print t; picResults.CurrentX = 580 picResults.Print t Exit Sub End If '----------------------------------------------------------- 'otherwise, continue with printing results as format check was OK '(lines of code values) picResults.CurrentX = 150 - picResults.TextWidth(Str(mlPropLines)) picResults.Print mlPropLines; picResults.CurrentX = 220 - picResults.TextWidth(Str(mlEventLines)) picResults.Print mlEventLines; picResults.CurrentX = 290 - picResults.TextWidth(Str(mlEventLines + mlPropLines)) picResults.Print mlEventLines + mlPropLines; '(bytes values) picResults.CurrentX = 590 - picResults.TextWidth(Str(mlPropBytes)) picResults.Print mlPropBytes; picResults.CurrentX = 660 - picResults.TextWidth(Str(mlEventBytes)) picResults.Print mlEventBytes; picResults.CurrentX = 730 - picResults.TextWidth(Str(mlPropBytes + mlEventBytes)) picResults.Print mlPropBytes + mlEventBytes 'display totals SetTotals End Sub Sub vsbResults_Change () 'reset vertical position of results pic box picResults.Top = -vsbResults End Sub